home *** CD-ROM | disk | FTP | other *** search
- ' ---------------------------------------------------------
- ' Copyright (C) 1995 Stephen Darlington
- '
- ' The distrubution of this file is covered by the
- ' agreement in the ICE help file.
-
- Option Explicit
- '
- ' ICE function declarations
- Declare Function Freeze Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal fuOptions As Long) As Integer
- Declare Function Thaw Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal fuOptions As Long) As Integer
- Declare Function TestArchive Lib "ice.dll" (ByVal lpLZH As String) As Integer
- Declare Function ListArchive Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal lpStr As String) As Integer
- Declare Function AddComment Lib "ice.dll" (ByVal lpLZH As String, ByVal lpComment As String) As Integer
- Declare Function DeleteComment Lib "ice.dll" (ByVal lpLZH As String) As Integer
- Declare Function GetCommentLength Lib "ice.dll" (ByVal lpLZH As String) As Integer
- Declare Function GetComment Lib "ice.dll" (ByVal lpLZH As String, ByVal lpComment As String) As Integer
- Declare Function DeleteComment Lib "ice.dll" (ByVal lpLZH As String) As Integer
- Declare Function ShowComment Lib "ice.dll" (ByVal lpLZH As String) As Integer
- Declare Sub InitialiseICE Lib "ice.dll" (ByVal hMain As Integer, ByVal hDisplay As Integer, ByVal fuOptions As Long)
- Declare Sub AboutICE Lib "ice.dll" ()
- '
- ' Constant for Freeze
- Global Const ICE_STOREFULLPATHS = &H0& 'default
- Global Const ICE_STORERELATIVEPATHS = &H1&
- Global Const ICE_STORENOPATHS = &H2&
- Global Const ICE_RECURSIVE = &H4&
- Global Const ICE_INCLUDEARCHIVEFILES = &H10&
- Global Const ICE_INCLUDEREADONLYFILES = &H20&
- Global Const ICE_INCLUDESYSTEMFILES = &H40&
- Global Const ICE_INCLUDEHIDDENFILES = &H80&
- Global Const ICE_INCLUDENORMALFILES = &H100& 'default
- Global Const ICE_TURNARCHIVEOFF = &H200&
- Global Const ICE_TURNREADONLYOFF = &H400&
- Global Const ICE_TURNSYSTEMOFF = &H800&
- Global Const ICE_TURNHIDDENOFF = &H1000&
- '
- ' Constants for Thaw
- Global Const ICE_RESTOREDIRECTORIES = &H1&
- Global Const ICE_DELETEFILES = &H2&
-
- ' Constants for Freeze and Thaw
- Global Const ICE_MOVEFILES = &H8&
- Global Const ICE_OVERWRITEALL = &H2000&
- Global Const ICE_OVERWRITEIFNEWER = &H4000&
- Global Const ICE_OVERWRITEQUERY = &H8000& 'default for both
- Global Const ICE_OVERWRITENEVER = &H10000
-
- ' Constants for InitailiseICE
- Global Const ICE_PASSPERCENT = &H1&
- Global Const ICE_PASSFILENAME = &H2&
-
- ' User-defined type for ListArchiveContents
- Type ICEINFO_TYPE
- sPath As String
- sFilename As String
- sDate As String * 8
- sTime As String * 8
- sAttributes As String * 4
- lOriginalSize As Long
- lCompressedSize As Long
- sRatio As String * 3
- sMethod As String * 5
- sCRC As String * 4
- End Type
-
- Function GetPiece (from As String, delim As String, Index As Integer) As String
- Dim temp$
- Dim Count As Integer
- Dim Where As Integer
- '
- temp$ = from & delim
- Where = InStr(temp$, delim)
- Count = 0
- Do While (Where > 0)
- Count = Count + 1
- If (Count = Index) Then
- GetPiece = Left$(temp$, Where - 1)
- Exit Function
- End If
- temp$ = Right$(temp$, Len(temp$) - Where)
- Where = InStr(temp$, delim)
- Loop
- If (Count = 0) Then
- GetPiece = from
- Else
- GetPiece = ""
- End If
- End Function
-
- Function ListArchiveContents (sMask As String, sLZH As String, info() As ICEINFO_TYPE)
- '
- ' VB function wrapper around the ICE function ListArchive
- '
- ' sMask - the files to retrieve (e.g. *.DLL or *.DOC)
- ' sLZH - the path and filename of the archive (e.g. C:\TEMP\ICE.LZH)
- ' info() - an array of type ICEINFO_TYPE provided by the user
- '
- ' This function returns the number of files retrieved into the
- ' users array if the function is successful. If the function is
- ' not successful, a (negative) error code is returned.
- '
- Dim all$, sTemp$
- Dim I As Integer
- Dim iCount As Integer
- Dim iCarat As Integer
- '
- all$ = String(60000, " ")
- iCount = ListArchive(sMask, sLZH, all$)
- If (iCount <= 0) Then
- all$ = ""
- ListArchiveContents = iCount
- If (iCount < -1) Then
- End
- Else
- Exit Function
- End If
- End If
- all$ = Left$(all$, InStr(all$, Chr$(0)) - 1)
- ReDim info(iCount)
- For I = 1 To iCount Step 1
- iCarat = InStr(all$, "^")
- sTemp$ = Left$(all$, iCarat - 1)
- info(I).sPath = GetPiece(sTemp$, "#", 1)
- info(I).sFilename = GetPiece(sTemp$, "#", 2)
- info(I).sDate = GetPiece(sTemp$, "#", 3)
- info(I).sTime = GetPiece(sTemp$, "#", 4)
- info(I).sAttributes = GetPiece(sTemp$, "#", 5)
- info(I).lOriginalSize = Val(GetPiece(sTemp$, "#", 6))
- info(I).lCompressedSize = Val(GetPiece(sTemp$, "#", 7))
- info(I).sRatio = GetPiece(sTemp$, "#", 8)
- info(I).sMethod = GetPiece(sTemp$, "#", 9)
- info(I).sCRC = GetPiece(sTemp$, "#", 10)
- all$ = Right$(all$, (Len(all$) - iCarat))
- Next I
- all$ = ""
- ListArchiveContents = iCount
- End Function
-
-